home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / nrpas13.arc / CRANK.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-01  |  723b  |  31 lines
  1. PROCEDURE crank(n: integer; VAR w: narray; VAR s: real);
  2. (* Programs using routine CRANK must define type
  3. TYPE
  4.    narray = ARRAY [1..n] OF real;
  5. in the calling routine *)
  6. LABEL 2;
  7. VAR
  8.    j,ji,jt,lbl1,lbl2: integer;
  9.    t,rank: real;
  10. BEGIN
  11.    s := 0.0;
  12.    j := 1;
  13.    WHILE (j < n) DO BEGIN
  14.       IF (w[j+1] <> w[j]) THEN BEGIN
  15.          w[j] := j;
  16.          j := j+1
  17.       END ELSE BEGIN
  18.          FOR jt := j+1 TO n DO BEGIN
  19.             IF (w[jt] <> w[J]) THEN GOTO 2;
  20.          END;
  21.          jt := n+1;
  22. 2:         rank := 0.5*(j+jt-1);
  23.          FOR ji := j TO jt-1 DO W[ji] := rank;
  24.          t := jt-j;
  25.          s := s+t*t*t-t;
  26.          j := jt
  27.       END
  28.    END;
  29.    IF (j = n) THEN w[n] := n
  30. END;
  31.